perm filename LAP[IL,LSP]4 blob
sn#203443 filedate 1976-02-26 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00006 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 (SETQ OLDBASE BASE)
C00010 00003 (LAP GWD SUBR)
C00012 00004 (LAP LAP FSUBR)
C00016 00005 (LAP LAPEVAL SUBR)
C00025 00006 (LAP DEFSYM SUBR)
C00028 ENDMK
C⊗;
(SETQ OLDBASE BASE)
(SETQ OLDIBASE IBASE)
(SETQ IBASE (SETQ BASE (ADD1 7)))
(DEFPROP SPECIAL (NIL . T) VALUE)
(DEFPROP LAPLST (NIL . NIL) VALUE)
(DEFPROP REMOB (NIL) VALUE)
(DEFPROP LAP
(LAMBDA(SL)
(PROG (L MARKLST COM0 REMOB LL)
(SETQ COM0 (GENSYM))
(SETQ MARKLST (LIST NIL))
(SETQ L BPORG)
A (COND ((NULL (SETQ LL (READ))) (GO END))
((ATOM LL) (DEFSYM LL L) (GO A)))
(DEPOSIT L (MAKNUM (GWD LL) (QUOTE FIXNUM)))
(FREELIST LL)
(SETQ L (ADD1 L))
(GO A)
END (DEFSYM COM0 L)
EN1 (COND
((NULL (SETQ MARKLST (CDR MARKLST)))
(APPLY# (QUOTE REMOB) REMOB)
(FREELIST REMOB)
(PUTPROP (CAR SL) (NUMVAL BPORG) (CADR SL))
(RETURN (SETQ SL (LIST (CAR SL) L)))))
(SETQ KLIST (CONS (CONS (CAR MARKLST) L) KLIST))
(DEPOSIT L (MAKNUM (GWD (CAR MARKLST)) (QUOTE FIXNUM)))
(SETQ L (ADD1 L))
(GO EN1))
(AND (REMPROP (CAR SL) (QUOTE NOCALL)) (DEFSYM (CAR SL) BPORG))
(SETQ BPORG (CADR SL))
SL)
FEXPR)
(DEFPROP TYPE
(LAMBDA (X) (COND ((NUMBERP X) (CADR X))))
EXPR)
(DEFPROP GWD
(LAMBDA(X)
(NUMVAL (PROG (WRD FLD)
(SETQ FLD
(QUOTE
((22 . -1) (27 . 17) (0 . 777777) (22 . 777777))))
(SETQ WRD 0)
(MAPC (FUNCTION
(LAMBDA(ZZ)
(PROG2 (SETQ WRD
(*PLUS WRD
(LSH (BOOLE 1
(CDAR FLD)
(LAPEVAL ZZ))
(CAAR FLD))))
(SETQ FLD (CDR FLD)))))
X)
(COND ((AND (CONSP (CADDR X))
(MEMQ (CAADDR X) @(QUOTE E))
(NEQ (CADDDR X) @S))
(SETQ WRD (*PLUS (*DIF WRD (EXAMINE 11)) (LSH 11 22))) ))
(COND ((EQ (CADDDR X) (QUOTE S))
(SETQ WRD (*DIF WRD (EXAMINE 11)))))
(RETURN WRD))))
EXPR)
(DEFPROP LAPEVAL
(LAMBDA(X)
(COND ((NUMBERP X) X)
((ATOM X) (GVAL X))
((MEMQ (CAR X) (QUOTE (E QUOTE)))
(MAKNUM
(COND
((OR (CONSP (SETQ X (CADR X))) (AND (NUMBERP X) (NEQ (*PLUS X 0) X)) (STRINGP X))
(PROG (Y)
(SETQ Y QLIST)
A (COND ((NULL Y) (RETURN (CAR (SETQ QLIST (CONS X QLIST)))))
((AND (EQUAL X (CAR Y)) (EQ (TYPE X) (TYPE (CAR Y)))) (RETURN (CAR Y))))
(SETQ Y (CDR Y))
(GO A)))
(T X))
(QUOTE FIXNUM)))
((EQ (CAR X) (QUOTE SPECIAL))
(COND ((NULL (GET (CADR X) (QUOTE VALUE))) (SET (CADR X) (UNBOUND) )))
(PROG (Y)
(RPLACA (SETQ Y (GET (CADR X) (QUOTE VALUE))) NIL)
(AND SPECIAL (NOT (ASSOC Y LAPLST)) (SETQ LAPLST (CONS (CONS Y (CADR X)) LAPLST)))
(RETURN (MAKNUM Y (QUOTE FIXNUM)))))
((EQ (CAR X) (QUOTE C))
(PROG (N CPTR)
(SETQ CPTR KLIST)
L11 (COND ((NULL CPTR) (GO L12)) ((EQUAL (CDR X) (CAAR CPTR)) (RETURN (CDAR CPTR))))
(SETQ CPTR (CDR CPTR))
(GO L11)
L12 (GVAL COM0)
(SETQ N 0)
(SETQ CPTR MARKLST)
A (COND ((NULL (CDR CPTR)) (RPLACD CPTR (LIST (CDR X))) (RETURN N)))
(COND ((EQUAL (CDR X) (CADR CPTR)) (RETURN N)))
(SETQ N (ADD1 N))
(SETQ CPTR (CDR CPTR))
(GO A)))
(T (*PLUS (LAPEVAL (CAR X)) (LAPEVAL (CDR X))))))
EXPR)
(DEFPROP DEFSYM
(LAMBDA(SYM VAL)
(PROG (Z)
(SETQ REMOB (CONS SYM REMOB))
(COND ((SETQ Z (GET SYM (QUOTE UNDEF))) (GO PATCH)))
A (RETURN (PUTPROP SYM VAL (QUOTE SYM)))
PATCH
(COND ((NULL Z) (REMPROP SYM (QUOTE UNDEF)) (GO A)))
(DEPOSIT (CAR Z) (*PLUS (EXAMINE (CAR Z)) VAL))
(SETQ Z (CDR Z))
(GO PATCH)))
EXPR)
(DEFPROP GVAL
(LAMBDA(SYM)
(COND ((GET SYM (QUOTE SYM)))
((GET SYM (QUOTE VALUE)) (MAKNUM SYM (QUOTE FIXNUM)))
(T (PUTPROP SYM
(CONS L (GET SYM (QUOTE UNDEF)))
(QUOTE UNDEF))
0)))
EXPR)
(DEFPROP OPS
(LAMBDA(L)
(PROG NIL
A (COND ((NULL L) (RETURN T)))
(PUTPROP (CAR L) (CADR L) (QUOTE SYM))
(SETQ L (CDDR L))
(GO A)))
FEXPR)
(OPS SUBI 275000 XCT 256000 MOVE 200000 MOVEI 201000 MOVEM 202000 →
JRST 254000 CALL 34000 JCA→
LL 35000 PUSHJ 260000 POPJ 263000 PUSH 261000 POP 262000 P 14 JSP 265→
000 EXCH 250000 JUMPE 322000 JUMPN 326000 SOJE 362000 SOJN 366000 CAI→
E 302000 CAIN 306000 CAME 312000 CAMN 316000 CALLF 36000 JCALLF 37000→
HRRZ@ 550020 HLRZ@ 554020 TDZA 634000 SUB 274000 HRRZ 550000 HLRZ 55→
4000 CLEARM 402000 CLEARB 403000 ADDI 271000 ADD 270000 MOVNI 211000 CALLF@ 36020→
JCALLF@ 37020 HRRM@ 542020 HRLM@ 506020 HRRZS@ 553020 HLLZS@ 513020 →
HRRM 542000 S 11 D 12 A 1 B 2 C 3 SETZM 402000)
(COND ((NULL (GET (QUOTE QLIST) (QUOTE VALUE))) (SETQ QLIST NIL)))
(COND ((NULL (GET (QUOTE KLIST) (QUOTE VALUE))) (SETQ KLIST NIL)))
(DEFPROP REMLAP
(LAMBDA NIL
(PROG (Z)
(SETQ Z (QUOTE (LAP LAPEVAL GWD DEFSYM REMLAP GVAL OPS TYPE)))
A (COND ((NULL Z) (GO B)))
(REMPROP (CAR Z) (QUOTE EXPR))
(REMPROP (CAR Z) (QUOTE FEXPR))
(SETQ Z (CDR Z))
(GO A)
B (REMOB REMLAP WRD FLD SL LL Z VAL END EN1 L11 L12 PATCH)))
EXPR)
(LAP GWD SUBR)
(PUSH P (C 0))
(PUSH P 1)
(PUSHJ P G0123)
(506000 1 -1 P)
(PUSHJ P G0123)
(242000 1 27)
(436000 1 -1 P)
(PUSHJ P G0123)
(HRRM 1 -1 P)
(JUMPE 1 G0BAZ)
(301000 1 377777)
(JRST 0 G0BAZ)
(HLRZ 1 0 P)
(305000 1 377777)
(HLRZ 1 0 1)
(CAIN 1 (E SPECIAL))
(JRST 0 G1BAZ)
(CAIE 1 (E QUOTE))
(CAIN 1 (E E))
G1BAZ (334000 1 (C 0 0 S))
G0BAZ (PUSHJ P G0123)
(CAIE 1 S)
(JRST 0 G0122)
(210000 2 S)
(272000 2 -1 P)
G0122 (514000 1 1)
(436000 1 -1 P)
G0124 (POP P 1)
(POP P 1)
(POPJ P)
G0125 (POP P 1)
(JRST 0 G0124)
G0123 (HRRZ 2 -1 P)
(JUMPE 2 G0125)
(HLRZ 1 0 2)
(HRRZ 2 0 2)
(HRRM 2 -1 P)
(506000 1 -1 P)
(CALL 1 (E LAPEVAL) S)
(JRST 0 NUMVAL)
NIL
(LAP LAP FSUBR)
(JSP 6 SPECBIND)
(0 0 (SPECIAL L) S)
(0 0 (SPECIAL MARKLST) S)
(0 0 (SPECIAL COM0) S)
(0 0 (SPECIAL REMOB) S)
(PUSH P 1)
(CALL 0 (E GENSYM) S)
(MOVEM 1 (SPECIAL COM0) S)
(MOVEI 1 (QUOTE NIL))
(CALL 1 (E NCONS) S)
(MOVEM 1 (SPECIAL MARKLST) S)
(MOVE 2 (SPECIAL BPORG) S)
(MOVEM 2 (SPECIAL L) S)
(PUSH P (C 0 0 (QUOTE NIL)))
G0001 (CALL 0 (E READ) S)
(MOVEM 1 0 P)(JUMPE 1 G0002)(CALL 1 (E ATOM) S)
(JUMPE 1 G0011)
(MOVE 2 (SPECIAL L) S)
(MOVE 1 0 P)
(CALL 2 (E DEFSYM) S)
(JRST 0 G0001)
G0011 (MOVE 1 0 P)
(CALL 1 (E GWD) S)
(MOVE 3 1)
(MOVE 1 (SPECIAL L) S)
(PUSHJ P NUMVAL)
(MOVEM 3 0 1)
(MOVE 1 0 P)
(CALL 1 (E FREELIST) S)
(MOVE 1 (SPECIAL L) S)
(CALL 1 (E ADD1) S)
(MOVEM 1 (SPECIAL L) S)
(MOVE 2 (SPECIAL BPEND) S)
(CALL 2 (E *LESS) S)
(JUMPN 1 G0001)
(CALL 0 (E TERPRI) S)
(MOVEI 1 (QUOTE BINARY/ PROGRAM/ SPACE/ EXCEEDED) S)
(CALL 1 (E PRINC) S)
(CALL 0 (E ERR) S)
G0002 (MOVE 2 (SPECIAL L) S)
(MOVE 1 (SPECIAL COM0) S)
(CALL 2 (E DEFSYM) S)
G0003 (HRRZ@ 1 (SPECIAL MARKLST) S)
(MOVEM 1 (SPECIAL MARKLST) S)
(JUMPN 1 G0022)
(MOVE 1 (SPECIAL REMOB) S)
(CALL 17 (E REMOB) S)
(MOVE 1 (SPECIAL REMOB) S)
(CALL 1 (E FREELIST) S)
(HLRZ@ 1 -1 P)
(PUSH P 1)
(MOVE 1 (SPECIAL BPORG) S)
(CALL 1 (E NUMVAL) S)
(HRRZ@ 3 -2 P)
(HLRZ@ 3 3)
(MOVE 2 1)
(POP P 1)
(CALL 3 (E PUTPROP) S)
(MOVE 1 (SPECIAL L) S)
(CALL 1 (E NCONS) S)
(HLRZ@ 2 -1 P)
(CALL 2 (E XCONS) S)
(MOVEM 1 -1 P)
(JRST 0 G0004)
G0022 (MOVE 2 (SPECIAL L) S)
(HLRZ@ 1 (SPECIAL MARKLST) S)
(CALL 2 (E CONS) S)
(MOVE 2 (SPECIAL KLIST) S)
(CALL 2 (E CONS) S)
(MOVEM 1 (SPECIAL KLIST) S)
(HLRZ@ 1 (SPECIAL MARKLST) S)
(PUSH P (SPECIAL L) S)
(CALL 1 (E GWD) S)
(MOVE 3 1)
(POP P 1)
(PUSHJ P NUMVAL)
(MOVEM 3 0 1)
(350000 0 1)
(CALL 2 (E MAKNUM) S)
(MOVEM 1 (SPECIAL L) S)
(JRST 0 G0003)
G0004 (SUB P (C 0 0 1 1))
(PUSHJ P SPECSTR)
(HLRZ@ 1 0 P)
(MOVEI 2 (QUOTE NOCALL) S)
(CALL 2 (E REMPROP) S)
(JUMPE 1 G0005)
(HLRZ@ 1 0 P)
(MOVE 2 (SPECIAL BPORG) S)
(CALL 2 (E DEFSYM) S)
G0005 (HRRZ@ 1 0 P)
(HLRZ@ 1 1)
(MOVEM 1 (SPECIAL BPORG) S)
(POP P 1)
(POPJ P)
NIL
(LAP LAPEVAL SUBR)
(PUSH P 1)
(CALL 1 (E NUMBERP) S)
(JUMPE 1 TAG5)
(MOVE 1 0 P)
(JRST 0 TAG4)
TAG5 (MOVE 1 0 P)
(CALL 1 (E ATOM) S)
(JUMPE 1 TAG6)
(MOVE 1 0 P)
(CALL 1 (E GVAL) S)
(JRST 0 TAG4)
TAG6 (MOVEI 2 (QUOTE (E QUOTE)) S)
(HLRZ@ 1 0 P)
(CALL 2 (E MEMQ) S)
(JUMPE 1 TAG7)
(HRRZ@ 1 0 P)
(HLRZ@ 1 1)
(MOVEM 1 0 P)
(CALL 1 (E ATOM) S)
(JUMPE 1 TAG12)
(MOVE 1 0 P)
(CALL 1 (E NUMBERP) S)
(JUMPE 1 TAG13)
(MOVEI 2 (QUOTE 0))
(MOVE 1 0 P)
(CALL 2 (E *PLUS) S)
(CAME 1 0 P)
(JRST 0 TAG12)
TAG13 (MOVE 1 0 P)
(CALL 1 (E STRINGP) S)
(JUMPE 1 TAG11)
TAG12 (PUSH P (SPECIAL QLIST) S)
TAG0 (MOVE 1 0 P)
(JUMPN 1 TAG20)
(MOVE 2 (SPECIAL QLIST) S)
(MOVE 1 -1 P)
(CALL 2 (E CONS) S)
(MOVEM 1 (SPECIAL QLIST) S)
(HLRZ@ 1 1)
(JRST 0 TAG14)
TAG20 (HLRZ@ 2 1)
(MOVE 1 -1 P)
(CALL 2 (E EQUAL) S)
(JUMPE 1 TAG21)
(MOVE 1 -1 P)
(CALL 1 (E TYPE) S)
(PUSH P 1)
(HLRZ@ 1 -1 P)
(CALL 1 (E TYPE) S)
(POP P 2)
(CAME 1 2)
(JRST 0 TAG21)
(HLRZ@ 1 0 P)
(JRST 0 TAG14)
TAG21 (HRRZ@ 1 0 P)
(MOVEM 1 0 P)
(JRST 0 TAG0)
TAG14 (SUB P (C 1 0 1 0))
(JRST 0 TAG10)
TAG11 (MOVE 1 0 P)
TAG23
TAG10 (MOVEI 2 (QUOTE FIXNUM) S)
(CALL 2 (E MAKNUM) S)
(JRST 0 TAG4)
TAG7 (HLRZ@ 2 0 P)
(CAIE 2 (QUOTE SPECIAL) S)
(JRST 0 TAG25)
(MOVEI 2 (QUOTE VALUE) S)
(HRRZ@ 1 0 P)
(HLRZ@ 1 1)
(CALL 2 (E GET) S)
(JUMPN 1 TAG27)
(CALL 1 (E UNBOUND) S)
~ (MOVEI 2 (QUOTE NIL))
~ (CALL 2 (E XCONS) S)
~ (MOVEI 3 (QUOTE VALUE) S)
(MOVE 2 1)
(HRRZ@ 1 0 P)
(HLRZ@ 1 1)
(CALL 2 (E SET) S)
TAG27 (MOVEI 2 (QUOTE VALUE) S)
(HRRZ@ 1 0 P)
(HLRZ@ 1 1)
(CALL 2 (E GET) S)
(HRRZS@ 0 1)
(PUSH P 1)
(MOVE 1 (SPECIAL SPECIAL) S)
(JUMPE 1 TAG34)
(MOVE 2 (SPECIAL LAPLST) S)
(MOVE 1 0 P)
(CALL 2 (E ASSOC) S)
(JUMPN 1 TAG34)
(HRRZ@ 2 -1 P)
(HLRZ@ 2 2)
(MOVE 1 0 P)
(CALL 2 (E CONS) S)
(MOVE 2 (SPECIAL LAPLST) S)
(CALL 2 (E CONS) S)
(MOVEM 1 (SPECIAL LAPLST) S)
(JUMPN 1 TAG33)
TAG34
TAG33 (MOVEI 2 (QUOTE FIXNUM) S)
(MOVE 1 0 P)
(CALL 2 (E MAKNUM) S)
(SUB P (C 1 0 1 0))
(JRST 0 TAG4)
TAG25 (HLRZ@ 3 0 P)
(CAIE 3 (QUOTE C) S)
(JRST 0 TAG35)
(PUSH P (SPECIAL KLIST) S)
(PUSH P (C 0 0 (QUOTE NIL) 0))
TAG1 (MOVE 1 -1 P)
(JUMPE 1 TAG2)
(HLRZ@ 2 1)
(HLRZ@ 2 2)
(HRRZ@ 1 -2 P)
(CALL 2 (E EQUAL) S)
(JUMPE 1 TAG42)
(HLRZ@ 1 -1 P)
(HRRZ@ 1 1)
(JRST 0 TAG36)
TAG42 (HRRZ@ 1 -1 P)
(MOVEM 1 -1 P)
(JRST 0 TAG1)
TAG2 (MOVE 1 (SPECIAL COM0) S)
(CALL 1 (E GVAL) S)
(MOVEI 1 (QUOTE 0))
(MOVEM 1 0 P)
(MOVE 1 (SPECIAL MARKLST) S)
(MOVEM 1 -1 P)
TAG3 (HRRZ@ 1 -1 P)
(JUMPN 1 TAG44)
(HRRZ@ 1 -2 P)
(CALL 1 (E NCONS) S)
(HRRM@ 1 -1 P)
(MOVE 1 0 P)
(JRST 0 TAG36)
TAG44 (HRRZ@ 2 -1 P)
(HLRZ@ 2 2)
(HRRZ@ 1 -2 P)
(CALL 2 (E EQUAL) S)
(JUMPE 1 TAG46)
(MOVE 1 0 P)
(JRST 0 TAG36)
TAG46 (MOVE 1 0 P)
(CALL 1 (E ADD1) S)
(MOVEM 1 0 P)
(HRRZ@ 1 -1 P)
(MOVEM 1 -1 P)
(JRST 0 TAG3)
TAG36 (SUB P (C 2 0 2 0))
(JRST 0 TAG4)
TAG35 (HLRZ@ 2 0 P)
(CAIE 2 (QUOTE SUBR) S) ~DO WE WANT A SUBR
(JRST 0 TAGR1)
(HRRZ@ 1 0 P) ~GET CDR
(HLRZ 1 0 1) ~GET CAR
(CALL 2 (E GET) S) ~(GET FN SUBR)
(JUMPE 2 E1)
(MOVEI 2 (QUOTE FIXNUM))
(CALL 2 (E MAKNUM))
(JRST 0 TAG4)
E1 (CALL 0 (E TERPRI) S)
(HRRZ@ 1 0 P)
(HLRZ 1 0 1)
(CALL 1 (E PRINC) S)
(MOVEI 1 (QUOTE / DOESN/'T/ HAVE/ A/ SUBR/ PROPERTY))
(CALL 1 (E PRINC) S)
(CALL 0 (E TERPRI) S)
(CALL 0 (E ERR) S)
TAGR1 (CAIN 2 (QUOTE CALL) S) ~DO WE XCT A CALL UUO FROM THE UPPER
(JRST 0 TAGR01)
(CAIE 2 (QUOTE JCALL) S) ~OR A JCALL
(JRST 0 TAGR3)
TAGR01
(MOVE 1 0 P) ~GET CALL
(HRRZ 1 0 1) ~GET CDR OF CALL
(HRRZ 1 0 1) ~GET CDR OF THAT I.E ((E FUNCT))
(HLRZ 1 0 1) ~GET CAR -- (E FUNCT)
(HRRZ 1 0 1) ~GET CDR -- (FUNCT)
(HLRZ 1 0 1) ~GET CAR -- FUNCT
(CALL 2 (E GET) S)
(JUMPN 1 TAGR00)
(MOVE 1 0 P)
(CALL 1 (E GWD) S) ~ASSEMBLE IT
(PUSH P 1) ~SAVE IT
(MOVE 2 16) ~GET POINTER TO FULL WORD LIST
(JUMPN 2 TAGR0) ~ARE THERE ANY
(CALL 0 (E GC) S) ~ NO! THEN GARBAGE COLLECT
(MOVE 2 16) ~GOT IT NOW!!
TAGR0 (PUSH P 2) ~SAVE POINTER
(MOVE 16 0 2) ~UPDATE FULL WORD LIST
(MOVE 1 -1 P) ~GET INSTRUCTION
(MOVEM 1 0 2) ~SAVE IT IN FULL WORD
(HRRZ@ 1 -2 P) ~GET CDR OF CALL
(HRRZ 1 0 1) ~GET CDR OF THAT I.E ((E FUNCT))
(HLRZ 1 0 1) ~GET CAR -- (E FUNCT)
(HRRZ 1 0 1) ~GET CDR -- (FUNCT)
(HLRZ 1 0 1) ~GET CAR -- FUNCT
(HLRZ@ 3 -2 P) ~GET CALL OR JCALL
(CALL 3 (E PUTPROP) S) ~(PUTPROP FUNCT INSTRUCTION (J)CALL)
(POP P 1) ~RETURN POINTER TO INSTRUCTION IN FWS
(MOVEI 2 (QUOTE FIXNUM))
(CALL 2 (E MAKNUM)) ~MAKE IT A LISP NUMBER
(POP P 2)
(JRST 0 TAG4)
TAGR00 (MOVEI 2 (QUOTE FIXNUM))
(CALL 2 (E MAKNUM)) ~MAKE IT A LISP NUMBER
(JRST 0 TAG4)
TAGR3 (HLRZ@ 1 0 P)
(CALL 1 (E LAPEVAL) S)
(PUSH P 1)
(HRRZ@ 1 -1 P)
(CALL 1 (E LAPEVAL) S)
(POP P 2)
(CALL 2 (E *PLUS) S)
TAG47
TAG4 (SUB P (C 1 0 1 0))
(POPJ P)
NIL
(LAP DEFSYM SUBR)
(PUSH P 2)
(MOVE 2 (SPECIAL REMOB) S)
(PUSH P 1)
(CALL 2 (E CONS) S)
(MOVEM 1 (SPECIAL REMOB) S)
(PUSH P (C 0 0 (QUOTE NIL)))
(MOVEI 2 (QUOTE UNDEF) S)
(MOVE 1 -1 P)
(CALL 2 (E GET) S)
(MOVEM 1 0 P)
(JUMPN 1 G0002)
G0001 (MOVEI 3 (QUOTE SYM) S)
(MOVE 2 -2 P)
(MOVE 1 -1 P)
(CALL 3 (E PUTPROP) S)
(JRST 0 G0003)
G0002 (MOVE 1 0 P)
(JUMPN 1 G0013)
(MOVE 1 -1 P)
(MOVEI 2 (QUOTE UNDEF) S)
(CALL 2 (E REMPROP) S)
(JRST 0 G0001)
G0013 (HLRZ@ 1 0 P)
(PUSH P 1)
(CALL 1 (E EXAMINE) S)
(MOVE 2 -3 P)
(CALL 2 (E *PLUS) S)
(MOVE 2 1)
(POP P 1)
(CALL 2 (E DEPOSIT) S)
(HRRZ@ 1 0 P)
(MOVEM 1 0 P)
(JRST 0 G0002)
G0003 (SUB P (C 0 0 3 3))
(POPJ P)
NIL
(LAP GVAL SUBR)
(PUSH P 1)
(MOVEI 2 (QUOTE SYM) S)
(CALL 2 (E GET) S)
(JUMPN 1 G0001)
(MOVEI 2 (QUOTE VALUE) S)
(MOVE 1 0 P)
(CALL 2 (E GET) S)
(JUMPE 1 G0003)
(MOVEI 2 (QUOTE FIXNUM) S)
(MOVE 1 0 P)
(CALL 2 (E MAKNUM) S)
(JRST 0 G0001)
G0003 (MOVEI 2 (QUOTE UNDEF) S)
(MOVE 1 0 P)
(CALL 2 (E GET) S)
(MOVE 2 (SPECIAL L) S)
(CALL 2 (E XCONS) S)
(MOVEI 3 (QUOTE UNDEF) S)
(MOVE 2 1)
(MOVE 1 0 P)
(CALL 3 (E PUTPROP) S)
(MOVEI 1 (QUOTE 0))
G0006
G0001 (SUB P (C 0 0 1 1))
(POPJ P)
NIL
(LAP TYPE SUBR)
(MOVE 2 1)
(CALL 1 (E NUMBERP) S)
(JUMPE 1 G0002)
(HRRZ@ 1 2)
(HLRZ@ 1 1)
G0002 (POPJ P)
NIL
(REMLAP)
(LAP OPS FSUBR)
(PUSH P 1)
TAG0 (MOVE 1 0 P)
(JUMPN 1 TAG5)
(MOVEI 1 (QUOTE T) S)
(JRST 0 TAG1)
TAG5 (MOVEI 3 (QUOTE SYM) S)
(HRRZ@ 2 0 P)
(HLRZ@ 2 2)
(HLRZ@ 1 0 P)
(CALL 3 (E PUTPROP) S)
(HRRZ@ 1 0 P)
(HRRZ@ 1 1)
(MOVEM 1 0 P)
(JRST 0 TAG0)
TAG1 (SUB P (C 1 0 1 0))
(POPJ P)
NIL
(SETQ BASE OLDBASE)
(SETQ IBASE OLDIBASE)